home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / 12a.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-01-30  |  34.6 KB  |  1,125 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. /* chapter 12 - part a*/
  11. #include "hdr.h"
  12. #include "vars.h"
  13. #include "libhdr.h"
  14. #include "attr.h"
  15. #include "unitsp.h"
  16. #include "errmsgp.h"
  17. #include "miscp.h"
  18. #include "smiscp.h"
  19. #include "setp.h"
  20. #include "libp.h"
  21. #include "dclmapp.h"
  22. #include "nodesp.h"
  23. #include "chapp.h"
  24.  
  25. static Tuple collect_generic_formals(Node);
  26. static void add_implicit_neq(Tuple, Node, Symbol);
  27. static void bind_names(Node);
  28.  
  29. void generic_subprog_spec(Node node)     /*;generic_subprog_spec*/
  30. {
  31.     int        nat, kind, i;
  32.     Node    id_node, generic_part_node, ret_node, formals_list;
  33.     int        f_mode, body_number;
  34.     char    *obj_id;
  35.     Symbol    gen_name, form_name, scope;
  36.     Tuple    gen_list, form_list;
  37.     Tuple    tup;
  38.     Node    formal_node, id_list, m_node, type_node, exp_node, init_node;
  39.     Symbol    type_mark;
  40.     Tuple    f_ids;
  41.     char    *id;
  42.     Fortup    ft1, ft2;
  43.  
  44.     /*
  45.      * Build specifications     of a  generic subprogram. We create  a scope for
  46.      * it, and  define within the  names of generics and  formal  parameters.
  47.      * The signature of the generic subprogram includes the generic parameter
  48.      * list and the formals. These two are unpacked during instantiation.
  49.      */
  50.     if (cdebug2 > 3)
  51.         TO_ERRFILE("AT PROC :  generic_subprog_spec ");
  52.  
  53.     id_node = N_AST1(node);
  54.     generic_part_node = N_AST2(node);
  55.     formals_list = N_AST3(node);
  56.     ret_node = N_AST4(node);
  57.     kind = N_KIND(node);
  58.  
  59.     obj_id = N_VAL(id_node);
  60.     new_compunit("ss", id_node);
  61.  
  62.     if (IS_COMP_UNIT) {
  63.         /* allocate unit number for body, and mark it obsolete */
  64.         body_number = unit_number(strjoin("su", obj_id));
  65.         pUnits[body_number]->libInfo.obsolete = string_ds; /*"$D$"*/
  66.     }
  67.  
  68.     gen_name = find_new(obj_id);
  69.     N_UNQ(id_node) = gen_name;
  70.     DECLARED(gen_name) = dcl_new(0);
  71.     NATURE(gen_name) = na_generic_part;
  72.     formal_decl_tree(gen_name) = (Symbol) formals_list;
  73.     newscope(gen_name);
  74.  
  75.     adasem(generic_part_node);
  76.     gen_list = collect_generic_formals(generic_part_node);
  77.     /*
  78.      * Now declared(gen_name) contains  the generic parameters: types,
  79.      * objects and    subprograms.
  80.      *
  81.      * For the formal parameters, we simply must recognize their names
  82.      * and    types. Type  checking on  initialization  is  repeated    on
  83.      * instantiation.
  84.      */
  85.     NATURE(gen_name) = na_void;        /* To catch premature usage. */
  86.     form_list = tup_new(0);
  87.  
  88.     FORTUP(formal_node =(Node), N_LIST(formals_list), ft1);
  89.         id_list = N_AST1(formal_node);
  90.         m_node = N_AST2(formal_node);
  91.         type_node = N_AST3(formal_node);
  92.         exp_node = N_AST4(formal_node);
  93.         type_mark = find_type(copy_tree(type_node));
  94.  
  95.         if (exp_node != OPT_NODE) {
  96.             adasem(exp_node);
  97.             init_node = copy_tree(exp_node);
  98.             normalize(type_mark, init_node);
  99.         }
  100.         else init_node = OPT_NODE;
  101.         current_node = formal_node;
  102.         f_ids = tup_new(tup_size(N_LIST(id_list)));
  103.         FORTUPI(id_node=(Node), N_LIST(id_list), i, ft2);
  104.             f_ids[i] = N_VAL(id_node);
  105.         ENDFORTUP(ft2);
  106.         f_mode = (int) N_VAL(m_node);
  107.         if (f_mode == 0 ) f_mode = na_in;
  108.  
  109.         FORTUP(id=, f_ids, ft2);
  110.             form_name = find_new(id);
  111.             NATURE(form_name)  = f_mode;
  112.             TYPE_OF(form_name) = type_mark;
  113.             default_expr(form_name) = (Tuple) copy_tree(init_node);
  114.             form_list = tup_with(form_list, (char *) form_name);
  115.         ENDFORTUP(ft2);
  116.  
  117.         if (f_mode != na_in && kind == as_generic_function) {
  118.             errmsg_l(nature_str(f_mode),
  119.               " parameter not allowed for functions", "6.5", formal_node);
  120.         }
  121.         /*  enforce restrictions on usage of out formal parameters given in
  122.           *  LRM 7.4.4
  123.          */
  124.         scope = SCOPE_OF(type_mark);
  125.         nat = NATURE(scope);
  126.         if (f_mode != na_out || is_access(type_mark))
  127.             continue;
  128.         else if (TYPE_OF(type_mark) == symbol_limited_private
  129.             && (nat == na_package_spec || nat == na_generic_package_spec 
  130.             || nat == na_generic_part )
  131.             && !in_private_part(scope)
  132.             && tup_mem((char *)scope, open_scopes) ) {
  133.             /* We    are in the visible  part of  the package that declares
  134.              * the type. Its  full  decl. will  have to be  given with an
  135.              * assignable type.
  136.               */
  137.             misc_type_attributes(type_mark) =  
  138.             (misc_type_attributes(type_mark)) | TA_OUT;
  139.         }
  140.         else if (is_limited_type(type_mark)) {
  141.             errmsg_id("Invalid use of limited type % for out parameter ",
  142.               type_mark, "7.4.4", formal_node);
  143.         }
  144.     ENDFORTUP(ft1);
  145.     /*
  146.      * Save signature of generic object, in the format which the
  147.      * instantiation procedure requires.
  148.      */
  149.     NATURE(gen_name) =
  150.         (kind == as_generic_procedure) ? na_generic_procedure_spec
  151.         : na_generic_function_spec;
  152.     tup = tup_new(4);
  153.     tup[1] = (char *) gen_list;
  154.     tup[2] = (char *) form_list;
  155.     tup[3] = (char *) OPT_NODE;
  156.     tup[4] = (char *) tup_new(0);
  157.     SIGNATURE(gen_name) = tup;
  158.     if (kind == as_generic_function) {
  159.         find_old(ret_node);
  160.         TYPE_OF(gen_name) = N_UNQ(ret_node);
  161.     }
  162.     else {
  163.         TYPE_OF(gen_name) = symbol_none;
  164.     }
  165.     popscope();
  166.  
  167.     save_subprog_info(gen_name);
  168. }
  169.  
  170. void generic_subprog_body(Symbol prog_name, Node node) /*;generic_subprog_body*/
  171. {
  172.     /*
  173.      * Within  its body,  the generic  subprogram  name behaves  as a regular
  174.      * (i.e. non-generic) subprogram. In  particular, it  can be  called (and
  175.      * it cannot be instantiated). Its nature must be set accordingly,  prior
  176.      * to compilation of the body.
  177.      */
  178.     int        new_nat, nat, i;
  179.     Tuple    sig, must_constrain;
  180.     Node    specs_node, decl_node, formals_node;
  181.     char    *spec_name;
  182.     char     *junk;
  183.     Tuple    specs, tup, gen_list, form_list, decscopes, decmaps, body_specs;
  184.     Symbol    generic_sym, g_name;
  185.     Unitdecl    ud;
  186.     Fortup    ft;
  187.  
  188.     /* if module is a generic subprogram body verify that the generic spec 
  189.      * appeared in the same file.
  190.      */
  191.     if (IS_COMP_UNIT) {
  192.         spec_name = strjoin("ss", unit_name_name(unit_name));
  193.         if (!streq(lib_unit_get(spec_name), AISFILENAME))
  194.         errmsg("Separately compiled generics not supported", "none", node);
  195.     }
  196.  
  197.     if (NATURE(prog_name) == na_generic_procedure_spec) {
  198.         new_nat = na_procedure;
  199.         nat = na_generic_procedure; /* Save till end of body. */
  200.     }
  201.     else {
  202.         new_nat = na_function;
  203.         nat = na_generic_function;
  204.     }
  205.  
  206.     /*
  207.      * save and stack the generic symbol for this subprogram to allow the
  208.      * detection of recursive instantiations within the generic body
  209.      */
  210.     generic_sym = sym_new_noseq(na_void);
  211.     sym_copy(generic_sym, prog_name);
  212.     NATURE(generic_sym) = nat;
  213.     current_instances = tup_with(current_instances, (char *)  generic_sym);
  214.  
  215.     NATURE(prog_name) = new_nat;
  216.     /*
  217.      * The signature of a  generic object includes    the generic  part. During
  218.      * compilation of the body, set the signature to contain only the formals
  219.      */
  220.     sig = SIGNATURE(prog_name);
  221.     gen_list = (Tuple) sig[1];
  222.     form_list = (Tuple) sig[2];
  223.     SIGNATURE(prog_name) = (Tuple) form_list;
  224.     OVERLOADS(prog_name) = set_new1((char *) prog_name);
  225.  
  226.     specs_node   = N_AST1(node);
  227.     formals_node = N_AST2(specs_node);
  228.     decl_node    = N_AST2(node);
  229.     newscope(prog_name);
  230.     reprocess_formals(prog_name, formals_node);
  231.     process_subprog_body(node, prog_name);
  232.     force_all_types();
  233.     popscope();
  234.     /*
  235.      * If a generic subprogram parameter is an equality operator, we must
  236.      * construct the body for the corresponding implicitly defined inequality
  237.      */
  238.     add_implicit_neq(gen_list, decl_node, prog_name);
  239.  
  240.     /* Outside of its body, the object is generic again.*/
  241.     NATURE(prog_name) = nat;
  242.     junk = tup_frome(current_instances);
  243.  
  244.     /* collect all generic types whose '$constrain' attribute is set into the
  245.      * tuple must_constrain and save it in the signature of the body
  246.      */
  247.  
  248.     must_constrain = tup_new(0);
  249.     FORTUP(tup=(Tuple), gen_list, ft)
  250.         g_name = (Symbol)tup[1];
  251.         if ((int)misc_type_attributes(g_name) & TA_CONSTRAIN)
  252.             must_constrain = tup_with(must_constrain, (char *)g_name);
  253.     ENDFORTUP(ft)
  254.  
  255.     sig= tup_new(4);
  256.     sig[1] = (char *) gen_list;
  257.     sig[2] = (char *) form_list;
  258.     sig[3] = (char *) node;
  259.     sig[4] = (char *) must_constrain;
  260.     SIGNATURE(prog_name) = sig; /* for instantiation */
  261.     OVERLOADS(prog_name) = (Set) 0;    /* Not a callable object. */
  262.  
  263.     /*
  264.      * If the  corresponding spec was defined in another compilation unit, it
  265.      * must     be updated  accordingly. If the generic is not itself a compila-
  266.      * tion unit, we  find the unit in which it appears, and update the info.
  267.      * Currently this is done only if both units are in the same compilation.
  268.      */
  269.  
  270.     if (IS_COMP_UNIT) {
  271.         pUnits[unit_number(unit_name)]->libInfo.obsolete = string_ok;
  272.         /*save it as any subprogram body. */
  273.         save_subprog_info(prog_name);
  274.     }
  275.     else if (streq(unit_name_type(unit_name), "bo") &&
  276.       streq(unit_name_name(unit_name), unit_name_names(unit_name)) ) {
  277.         spec_name = strjoin("sp", unit_name_name(unit_name));
  278.         ud = unit_decl_get(spec_name);
  279.         if (streq(lib_unit_get(spec_name), AISFILENAME) && (ud!=(Unitdecl)0)) {
  280.             /* i.e. current compilation, and separate unit, already seen.
  281.               * update symbol table information for all entities in body.
  282.               * Probably incomplete on unit_nodes, declared, etc.
  283.              */
  284.             /* [n, specs, decmap, o, v, c, nodes] := UNIT_DECL(spec_name); */
  285.             specs = ud->ud_symbols;
  286.             body_specs = unit_symbtab(prog_name, 'u');
  287.  
  288.             /* (for [nam, info] in body_specs)
  289.              *   specs(nam) := info;
  290.              * end for;
  291.              */
  292.              for (i = 1; i <= tup_size(body_specs); i++)
  293.                 specs = sym_save(specs, (Symbol)body_specs[i], 'u');
  294.  
  295.              /* decmap(prog_name) := declared(prog_name); */
  296.             decscopes = ud->ud_decscopes;
  297.             decmaps   = ud->ud_decmaps;
  298.             for (i = 1; i<= tup_size(decscopes); i++)
  299.                 if (prog_name == (Symbol)(decscopes[i]))
  300.                     break;
  301.             decmaps[i] = (char *)dcl_copy(DECLARED(prog_name));
  302.             /* is copy necessary ? */
  303.  
  304.             /* UNIT_DECL(spec_name):= [n, specs, decmap, o, v, c, 
  305.                 *                       nodes + UNIT_NODES];
  306.                */
  307.             ud->ud_symbols = specs;
  308.             for (i = 1; i <= tup_size(unit_nodes); i++)
  309.                 ud->ud_nodes = tup_with(ud->ud_nodes, unit_nodes[i]);
  310.         }
  311.     }
  312.     else {
  313.         /* If it is a subunit of a subprogram unit, it is only visible within
  314.          * this unit, and no update is needed.
  315.          */
  316. #ifdef TBSL
  317.         unit_kind : = om;
  318. #endif
  319.     }
  320.  
  321.     N_KIND(node) = (nat == na_generic_procedure) ? as_generic_procedure
  322.         : as_generic_function;
  323. }
  324.  
  325. static void add_implicit_neq(Tuple gen_list, Node decl_node, Symbol prog_name)
  326. /*;add_implicit_neq*/
  327. {
  328.     /*
  329.      * if a generic subprogram parameter is an equality operator, an implicit
  330.      * inequality is thus defined, and a symbol table entry for it has been
  331.      * constructed at the same time as that for the equality. We place a 
  332.      * declaration for its body in the declarative    part of the generic unit.
  333.      * It  will thus  be instantiated in the same way as other local entity.
  334.      */
  335.     Fortup    ft1;
  336.     Forset    fs1;
  337.     Tuple    tup;
  338.     Symbol    g_name, neq;
  339.     int        exists;
  340.     Node    neq_node;
  341.     Set        oset;
  342.  
  343.     FORTUP(tup=(Tuple), gen_list, ft1);
  344.         g_name = (Symbol) tup[1];
  345.  
  346.         if (NATURE(g_name) != na_function) continue;
  347.         if (streq(original_name(g_name), "=") == FALSE) continue;
  348.         exists = FALSE;
  349.         oset = (Set)OVERLOADS(dcl_get(DECLARED(prog_name), "/="));
  350.         FORSET(neq=(Symbol), oset, fs1);
  351.             if (same_signature(g_name, neq)) {
  352.                 exists = TRUE;
  353.                 break;
  354.             }
  355.         ENDFORSET(fs1);
  356.         if (!exists) continue;
  357.         neq_node = new_not_equals(neq, g_name);
  358. #ifdef TBSL
  359.         N_LIST(decl_node) :
  360.         = [neq_node] + N_LIST(decl_node);
  361. #endif
  362.         N_LIST(decl_node) = tup_with(N_LIST(decl_node), (char *)neq_node);
  363.     ENDFORTUP(ft1);
  364. }
  365.  
  366. void generic_pack_spec(Node node)     /*;generic_pack_spec*/
  367. {
  368.     Node    id_node, generic_part_node, decl_node, priv_node;
  369.     Tuple    tup, gen_list;
  370.  
  371.     if (cdebug2 > 3)
  372.         TO_ERRFILE("AT PROC :  generic_pack_spec");
  373.  
  374.     id_node = N_AST1(node);
  375.     generic_part_node = N_AST2(node);
  376.     decl_node = N_AST3(node);
  377.     priv_node = N_AST4(node);
  378.  
  379.     new_package(id_node, na_generic_part);
  380.  
  381.     /*
  382.      * Process generic parameters. Their definition will appear in
  383.      * the scope of the generic package. The list of them is also
  384.      * preserved in the signature of the package, for instantiation.
  385.      * The signature of the generic package as the format:
  386.      *
  387.      *  [[generic_type_list, visible_decls, private_part, body, must_constrain]
  388.      *
  389.      * The body will be seen later, its place kept by a null node.
  390.      * Must_constrain is the list of generic types that must be constrained upon
  391.      * instantiation. It is created by module_body after processing the generic
  392.      * package body.
  393.      */
  394.     adasem(generic_part_node);
  395.     tup = tup_new(5);
  396.     gen_list = collect_generic_formals(generic_part_node);
  397.     tup[1] = (char *) gen_list;
  398.     tup[2] = (char *) decl_node;
  399.     tup[3] = (char *) priv_node;
  400.     tup[4] = (char *) OPT_NODE;
  401.     tup[5] = (char *) tup_new(0);
  402.  
  403.     SIGNATURE(scope_name) = tup;
  404.     NATURE(scope_name)    = na_generic_package_spec;
  405.  
  406.     /* The rest of the package is processed as in a non-generic case.*/
  407.     package_declarations(decl_node, priv_node);
  408.     add_implicit_neq(gen_list, decl_node, scope_name);
  409.     end_specs(scope_name);
  410. }
  411.  
  412. void generic_obj_decl(Node node) /*;generic_obj_decl*/
  413. {
  414.     Node    id_list_node, in_out_node, type_node, init_node, id_node;
  415.     Tuple    id_nodes;
  416.     int        kind;
  417.     Symbol    type_mark, name;
  418.     Tuple    nam_list;
  419.     Fortup    ft1;
  420.     int        i;
  421.  
  422.     if (cdebug2 > 3)
  423.         TO_ERRFILE("AT PROC :  generic_obj_decl");
  424.  
  425.     id_list_node = N_AST1(node);
  426.     in_out_node = N_AST2(node);
  427.     type_node = N_AST3(node);
  428.     init_node = N_AST4(node);
  429.  
  430.     id_nodes = N_LIST(id_list_node);
  431.     nam_list = tup_new(tup_size(id_nodes));
  432.     FORTUPI(id_node=(Node), id_nodes, i, ft1);
  433.         nam_list[i] = (char *) find_new(N_VAL(id_node));
  434.     ENDFORTUP(ft1);
  435.     for (i = 1; i <= tup_size(id_nodes); i++)
  436.         N_UNQ((Node)id_nodes[i]) = (Symbol) nam_list[i];
  437.  
  438.     kind = (int) N_VAL(in_out_node);
  439.     if (kind == 0 ) kind = na_in;
  440.     find_type(type_node);
  441.     type_mark = N_UNQ(type_node);
  442.     if (is_incomplete_type(type_mark))
  443.         errmsg_id("Premature use of incomplete or private type %",
  444.           type_mark, "7.4.1", type_node);
  445.     adasem(init_node);
  446.  
  447.     if (kind == na_in) {
  448.         if (is_limited_type(type_mark)) {
  449.             errmsg_l("Type of a generic formal object of mode IN must not",
  450.               " be a limited type", "12.1.1", type_node);
  451.         }
  452.  
  453.         if (init_node != OPT_NODE) {
  454.             /* Type check  default value. */
  455.             bind_names(init_node);
  456.             check_type(type_mark, init_node);
  457.             if (is_deferred_constant(init_node) ) {
  458.                 errmsg_l("Deferred constant cannot be default expression",
  459.                   " for a generic parameter", "7.4.3", init_node);
  460.             }
  461.         }
  462.     }
  463.     else if (kind == na_inout) {
  464.         /* No constraints apply to generic inout formals.*/
  465.         type_mark = base_type(type_mark);
  466.  
  467.         if (init_node != OPT_NODE) {
  468.             errmsg("Initialization not allowed for IN OUT generic parameters",
  469.               "12.1.1", init_node);
  470.         }
  471.     }
  472.     else if (kind == na_out) {
  473.         errmsg("OUT generic formals objects not allowed",
  474.           "12.1.1", in_out_node);
  475.     }
  476.  
  477.     FORTUP(name=(Symbol), nam_list, ft1);
  478.         if (kind == na_in) NATURE(name) =  na_in;
  479.         else NATURE(name)= na_inout;
  480.         TYPE_OF(name)   = type_mark;
  481.         SIGNATURE(name) = (Tuple) init_node;
  482.     ENDFORTUP(ft1);
  483. }
  484.  
  485. void generic_type_decl(Node node) /*;generic_type_decl*/
  486. {
  487.     Node    id_node, def_node, range_node, opt_disc;
  488.     char    *id, *root_id;
  489.     Symbol    root;
  490.     /*char    *attr;*/
  491.     Symbol    type_name, anon_type, generic_base, t;
  492.     Node    lo, hi, attr_node, precision, type_node;
  493.     Tuple    ncon, bounds;
  494.     int        kind;
  495.  
  496.     if (cdebug2 > 3)
  497.         TO_ERRFILE("AT PROC :  generic_type_decl");
  498.  
  499.     id_node = N_AST1(node);
  500.     opt_disc = N_AST2(node);
  501.     def_node = N_AST3(node);
  502.     id = N_VAL(id_node);
  503.     /*
  504.      * In the case of generic array types, anonymous parent array may be
  505.      * introduced. They are not generic in themselves, and play no role in
  506.      * the instantiated code; they are collected here and  discarded.
  507.      */
  508.     newtypes = tup_with(newtypes , (char *) tup_new(0));
  509.     if (N_KIND(def_node) == as_generic) {    /*scalar type*/
  510.         type_name = find_new(id);
  511.         N_UNQ(id_node) = type_name;
  512.         root_id = N_VAL(def_node);
  513.         if (streq(root_id, "INTEGER")) root = symbol_integer;
  514.         else if (streq(root_id, "discrete_type")) root = symbol_discrete_type;
  515.         else if (streq(root_id, "FLOAT")) root = symbol_float;
  516.         else if (streq(root_id, "$FIXED")) root = symbol_dfixed;
  517.         else chaos("generic_type_decl(12) bad generic type");
  518.  
  519.         /* A generic signature must be constructed for these types, in
  520.          * order to verify bounds  in instantiations,  subtypes,  etc.
  521.          * These bounds must expressed by means of attributes.
  522.          */
  523.         if (root == symbol_integer || root == symbol_discrete_type) {
  524.             type_node = new_name_node(type_name);
  525.             lo = new_attribute_node(ATTR_T_FIRST,type_node,OPT_NODE, type_name);
  526.             type_node = new_name_node(type_name);
  527.             hi = new_attribute_node(ATTR_T_LAST, type_node,OPT_NODE, type_name);
  528.             /*bounds := ['range', lo, hi];*/
  529.             bounds = constraint_new(CONSTRAINT_RANGE);
  530.             numeric_constraint_low(bounds) = (char *)lo;
  531.             numeric_constraint_high(bounds) = (char *)hi;
  532.             range_node = node_new(as_range);
  533.             N_AST1(range_node) = lo;
  534.             N_AST2(range_node) = hi;
  535.             N_AST1(def_node) = range_node;
  536.         }
  537.         else {
  538.             ncon = (Tuple) SIGNATURE(root);
  539.             kind = (int)numeric_constraint_kind(ncon);
  540.             lo = (Node) numeric_constraint_low(ncon);
  541.             hi = (Node) numeric_constraint_high(ncon);
  542.             /*[kind, lo, hi, precision] := signature(root);*/
  543.             attr_node = node_new(as_number);
  544.             /* proper attr code filled in below */
  545.             if (kind == CONSTRAINT_DIGITS) {
  546.                 N_VAL(attr_node) = (char *) ATTR_DIGITS;
  547.             }
  548.             else {
  549.                 N_VAL(attr_node) = (char *) ATTR_DELTA;
  550.                 /* N_VAL(attr_node) = if kind = 'digits' then 'DIGITS' 
  551.                   *    else 'DELTA' end;
  552.                   */
  553.             }
  554.             precision = node_new(as_attribute);
  555.             type_node = new_name_node(type_name);
  556.             N_AST1(precision) = attr_node;
  557.             N_AST2(precision) = type_node;
  558.             N_AST3(precision) = OPT_NODE;
  559. #ifdef TBSL
  560.             -- check this out, SETL seems wrong
  561.                 N_AST(def_node)  :
  562.             = precision;
  563. #endif
  564.             /*bounds = [kind, lo, hi, precision];*/
  565.             bounds = constraint_new(kind);
  566.             numeric_constraint_low(bounds) = (char *)lo;
  567.             numeric_constraint_high(bounds) = (char *)hi;
  568.             numeric_constraint_digits(bounds) = (char *)precision;
  569.         }
  570.         /* The base type of a generic type is the base of its actual. In
  571.          * order to be able to refer to the base type of a generic within
  572.          * the object, we introduce an anonymous type that will be instan
  573.          * tiated with the base type of the actual.
  574.          */
  575.         generic_base = anonymous_type();
  576.         NATURE(generic_base) = na_type;
  577.         TYPE_OF(generic_base) = root;
  578.         SIGNATURE(generic_base) = (Tuple) bounds;
  579.         root_type(generic_base) = root_type(root);
  580.         misc_type_attributes(generic_base) = TA_GENERIC;
  581.  
  582.         /*SYMBTAB(type_name) := [na_subtype, generic_base, bounds];*/
  583.         NATURE(type_name) = na_subtype;
  584.         TYPE_OF(type_name) = generic_base;
  585.         SIGNATURE(type_name) = bounds;
  586.         root_type(type_name) = root_type(root);
  587.     }
  588.     else {    /* array type or access type.*/
  589.         type_decl(node);
  590.         type_name = N_UNQ(id_node);
  591.         if (is_access(type_name))
  592.             t = (Symbol) designated_type(type_name);
  593.         else t = (Symbol) component_type(type_name);
  594.         /* note that a generic type defintion is not a type declaration and
  595.          * therefore, the component or designated type of a generic type
  596.          * cannot be an incomplete private type.
  597.          */
  598.         if (private_ancestor(t) != (Symbol)0 )
  599.         errmsg_id("Premature usage of type % before its full declaration",
  600.           t, "7.4.1", node);
  601.     }
  602.  
  603.     misc_type_attributes(type_name) =
  604.       misc_type_attributes(type_name) | TA_GENERIC;
  605.  
  606.     anon_type = (Symbol)tup_frome( newtypes);
  607. }
  608.  
  609. void generic_priv_decl(Node node)     /*;generic_priv_decl*/
  610. {
  611.     Node    id_node;
  612.     Symbol    type_name, discr;
  613.     Fortup    ft;
  614.  
  615.     if (cdebug2 > 3)
  616.         TO_ERRFILE("AT PROC :  generic_priv_decl");
  617.  
  618.     private_decl(node);
  619.  
  620.     id_node = N_AST1(node);
  621.     type_name = N_UNQ(id_node);
  622.     if (type_name == symbol_any)   /* previous error */
  623.         return;
  624.     misc_type_attributes(type_name) = TA_GENERIC;
  625.  
  626.     FORTUP(discr=(Symbol), discriminant_list(type_name), ft)
  627.         if (discr == symbol_constrained) continue;
  628.         if ((Node)default_expr(discr) != OPT_NODE) {
  629.             errmsg(
  630.               "generic private type cannot have defaults for discriminants",
  631.               "12.1.2", (Node)default_expr(discr) );
  632.             return;
  633.         }
  634.     ENDFORTUP(ft)
  635. }
  636.  
  637. void check_generic_usage(Symbol type_mark)    /*;check_generic_usage*/
  638. {
  639.     /*
  640.      * if a private generic type, or a subtype or derived type of it, is used
  641.      * in an object declaration, component declaration, or allocator, indicate
  642.      * that it must be instantiated with a constrained type.
  643.      */
  644.     Symbol    t;
  645.  
  646.     t = root_type(type_mark);
  647.  
  648.     if (in_priv_types(TYPE_OF(t)) && is_generic_type(t)
  649.       && (can_constrain(type_mark) || ! has_discriminants(type_mark)) )
  650.         misc_type_attributes(t) = misc_type_attributes(t) | TA_CONSTRAIN;
  651. }
  652.  
  653. void generic_subp_decl(Node node)     /*;generic_subp_decl*/
  654. {
  655.     Node    spec_node, opt_is_node, id_node, formal_list, ret_node;
  656.     char    *id;
  657.     Tuple    formals;
  658.     Symbol    ret, name, anon_subp;
  659.     int     kind;
  660.  
  661.     if (cdebug2 > 3)
  662.         TO_ERRFILE("AT PROC :  generic_subp_decl");
  663.  
  664.     spec_node = N_AST1(node) ;
  665.     opt_is_node = N_AST2(node) ;
  666.     adasem(spec_node);
  667.     id_node = N_AST1(spec_node);
  668.     formal_list = N_AST2(spec_node);
  669.     ret_node = N_AST3(spec_node);
  670.     id = N_VAL(id_node);
  671.     formals = get_formals(formal_list, id);
  672.     if (N_KIND(spec_node) == as_procedure ) {
  673.         kind = na_procedure;
  674.         ret = symbol_none;
  675.     }
  676.     else {
  677.         kind = na_function;
  678.         ret = N_UNQ(ret_node);
  679.     }
  680.     if (in_op_designators(id ))        /* check format, if operator spec */
  681.         check_new_op(id_node, formals, ret);
  682.     name = chain_overloads(id, kind, ret, formals, (Symbol)0, OPT_NODE);
  683.     N_UNQ(id_node) = name;
  684.  
  685.     /* a generic subprogram parameter is treated as a renaming of some
  686.      * unspecified subprogram whose actual name will be supplied at
  687.      * the point of instantiation
  688.      */
  689.     anon_subp = sym_new(kind);
  690.     TYPE_OF(anon_subp) = TYPE_OF(name);
  691.     SIGNATURE(anon_subp) = SIGNATURE(name);
  692.     SCOPE_OF(anon_subp) = scope_name;
  693.     dcl_put(DECLARED(scope_name), newat_str(), anon_subp);
  694.     ALIAS(name) = anon_subp;
  695.  
  696.     if (N_KIND(opt_is_node) == as_string) /* Default val is an operator name.*/
  697.         desig_to_op(opt_is_node);
  698.     else
  699.         adasem(opt_is_node) ;
  700.  
  701.     if (opt_is_node != OPT_NODE) {
  702.         if (N_KIND(opt_is_node) == as_simple_name
  703.             /* had 'box' in next line TBSL check type */
  704.         && streq(N_VAL(opt_is_node) , "box")) {
  705.             ;
  706.         }
  707.         else {
  708.             find_old(opt_is_node);
  709.             /* verify that the default has a matching signature */
  710.             current_node = opt_is_node;
  711.             if (tup_size(find_renamed_entity(kind,
  712.               formals, ret, opt_is_node)) == 0)
  713.                 N_AST2(node) = OPT_NODE; /* renaming error */
  714.             if (name == N_UNQ(opt_is_node))
  715.             errmsg_str("invalid reference to %", id, "8.3(16)", opt_is_node);
  716.         }
  717.     }
  718. }
  719.  
  720. static void bind_names(Node node)        /*;bind_names*/
  721. {
  722.     Node    name, sel, arg_list, arg1, arg2, arg;
  723.     Fortup    ft1;
  724.     int    nk;
  725.  
  726.     if (cdebug2 > 3)
  727.         TO_ERRFILE("AT PROC :  bind_names");
  728.     /*
  729.      * Perform name resolution for default initializations for generic IN
  730.      * parameters and for discriminant specifications.
  731.      */
  732.     switch (nk = N_KIND(node)) {
  733.       case    as_name:
  734.                 find_old(node);
  735.                 bind_names(node);
  736.                 break;
  737.       case    as_selector:
  738.                 name = N_AST1(node);
  739.                 sel = N_AST2(node);
  740.                 bind_names(name);
  741.                 break;
  742.       case    as_call_unresolved:
  743.       case    as_op:
  744.       case    as_un_op:
  745.                 name = N_AST1(node);
  746.                 arg_list = N_AST2(node);
  747.                 find_old(name);
  748.                 FORTUP(arg =(Node), N_LIST(arg_list), ft1);
  749.                     bind_names(arg);
  750.                 ENDFORTUP(ft1);
  751.                 break;
  752.       case    as_attribute:
  753.                 arg1 = N_AST2(node);
  754.                 arg2 = N_AST3(node);
  755.                 bind_names(arg1);
  756.                 bind_names(arg2);
  757.                 break;
  758.     } /* End switch */
  759. }
  760.  
  761. static Tuple collect_generic_formals(Node generic_part_node)
  762. /*;collect_generic_formals*/
  763. {
  764.     Tuple    gen_list;
  765.     Node    n, id_list_node, init_node, id_node, spec_node;
  766.     int        nk;
  767.     Fortup    ft1, ft2;
  768.     Tuple    tup;
  769.     /*
  770.      * Collect names of generic parameters, and defaults when present.
  771.      * Return a list of pairs [unique_name, default], which is attached to
  772.      * the generic object to simplify instantiation.
  773.      */
  774.  
  775.     if (cdebug2 > 3)
  776.         TO_ERRFILE("AT PROC: collect_generic_formals");
  777.     gen_list = tup_new(0);
  778.  
  779.     FORTUP(n =(Node), N_LIST(generic_part_node), ft1);
  780.         nk = N_KIND(n);
  781.         if (nk == as_generic_obj) {
  782.             id_list_node = N_AST1(n);
  783.             init_node = N_AST4(n);
  784.             FORTUP(id_node=(Node), N_LIST(id_list_node), ft2);
  785.                 tup = tup_new(2);
  786.                 tup[1] = (char *) N_UNQ(id_node);
  787.                 tup[2] = (char *) init_node;
  788.                 gen_list = tup_with(gen_list, (char *) tup);
  789.             ENDFORTUP(ft2);
  790.         }
  791.         else if (nk == as_generic_subp) {
  792.             spec_node = N_AST1(n);
  793.             init_node = N_AST2(n);
  794.             id_node = N_AST1(spec_node);
  795.             tup = tup_new(2);
  796.             tup[1] = (char *) N_UNQ(id_node);
  797.             tup[2] = (char *) init_node;
  798.             gen_list = tup_with(gen_list, (char *) tup);
  799.         }
  800.         else {    /*Generic type definition*/
  801.             id_node = N_AST1(n);
  802.             tup = tup_new(2);
  803.             tup[1] = (char *) N_UNQ(id_node);
  804.             tup[2] = (char *) OPT_NODE;
  805.             gen_list = tup_with(gen_list, (char *) tup);
  806.         }
  807.     ENDFORTUP(ft1);
  808.     return gen_list;
  809. }
  810.  
  811. void subprog_instance(Node node) /*;subprog_instance*/
  812. {
  813.     Node    id_node, gen_node, spec_node, instance_node, body_node,stmt_node;
  814.     char    *new_id, *body_name;
  815.     Symbol    gen_name;
  816.     int        kind;
  817.     Tuple    generics, instance_list;
  818.     Tuple    formals;
  819.     Symbol    return_type;
  820.     Tuple    new_info;
  821.     Symbol    new_return;
  822.     Tuple    new_specs;
  823.     Symbol    proc_name;
  824.     Tuple    tup;
  825.     Fortup    ft1;
  826.     Symbol    new_f, f;
  827.     Tuple    new_formals;
  828.     Symbolmap    type_map;
  829.     int        ii, body_num, s ;
  830.     int        has_default = FALSE;
  831.     Tuple    newtup;
  832.     Set        body_precomp;
  833.     Forset    fs1;
  834.  
  835.     /*
  836.      * Create an instantiation of a generic procedure.
  837.      *
  838.      * To construct     the new instance, we  first process the instantiation of
  839.      * the    generics. This yields a series    of renames  statements, which map
  840.      * the generic parameters  into      actual types and  subprograms. This map
  841.      * is used to rename all generic entities within the spec and body of the
  842.      * generic object, to yield the AST and SYMBTAB for the instantiated one.
  843.      */
  844.     if (cdebug2 > 3)
  845.         TO_ERRFILE("AT PROC : subprog_instance");
  846.  
  847.     id_node     = N_AST1(node);
  848.     gen_node = N_AST2(node);
  849.     instance_node = N_AST3(node);
  850.     /* instantiate_generics adds to list - don't want to modify OPT_NODE */
  851.     if (instance_node == OPT_NODE) {
  852.         instance_node = node_new(as_list);
  853.         N_LIST(instance_node) = tup_new(0);
  854.         N_AST3(node) = instance_node;
  855.     }
  856.     new_id = N_VAL(id_node);
  857.     new_compunit("su", id_node);
  858.     find_old(gen_node);
  859.     gen_name = N_UNQ(gen_node);
  860.     if (gen_name == (Symbol)0) gen_name = symbol_any_id;
  861.     /*
  862.      * In the case where the instantiation is a compilation unit, the context
  863.      * of the generic body needs to be transferred to the instatiation. This
  864.      * is done by adding the body of the generic (if it has been seen) to the
  865.      * all_vis insuring that the body is loaded and all that it references
  866.      * is loaded (transitivly) in INIT_GEN.
  867.      * In the case where the generic spec and body are not in the same unit,
  868.      * it is also necessary to bring in the context of the body for 
  869.      * instantiation. This is accomplished by adding the PRECOMP of the body
  870.      * to the PRECOMP (all_vis) of the unit containing the instantiation.
  871.      */
  872.     body_name = strjoin("su", ORIG_NAME(gen_name));
  873.     body_num = unitNumberFromLibUnit(body_name);
  874.     if (IS_COMP_UNIT) {
  875.         if (body_num)
  876.             all_vis = tup_with(all_vis, body_name);
  877.     }
  878.     if (!body_num) {     /* generic is not a library unit, but nested somewhere */
  879.         if (S_UNIT(gen_name) != unit_number_now &&
  880.             streq(unit_name_type(pUnits[S_UNIT(gen_name)]->name),"sp")) {
  881.             body_name = strjoin("bo",
  882.                         unit_name_name(pUnits[S_UNIT(gen_name)]->name));
  883.             retrieve(body_name);
  884.             body_num = unit_numbered(body_name);
  885.         }
  886.     }
  887.     if (body_num != 0 && pUnits[body_num]->aisInfo.preComp != (char *)0) {
  888.         /* check for previous errors */
  889.         body_precomp = (Set) pUnits[body_num]->aisInfo.preComp;
  890.         FORSET( s=(int), body_precomp, fs1 );
  891.             all_vis = tup_with(all_vis,pUnits[s]->name);
  892.         ENDFORSET(fs1);
  893.     }
  894.     kind = ( N_KIND(node) == as_procedure_instance ) ? na_procedure
  895.         : na_function;
  896.  
  897.     if ((kind == na_procedure && 
  898.       (NATURE(gen_name) != na_generic_procedure
  899.       && NATURE(gen_name) != na_generic_procedure_spec))
  900.       || (kind == na_function && (NATURE(gen_name) != na_generic_function
  901.       && NATURE(gen_name) != na_generic_function_spec))) {
  902.         errmsg_l("not a generic ", nature_str(kind), "12.1, 12.3", gen_node);
  903.         return;
  904.     }
  905. #ifdef XREF
  906.     TO_XREF(gen_name);
  907. #endif
  908.     tup = SIGNATURE(gen_name);
  909.     generics = (Tuple) tup[1];
  910.     formals = (Tuple) tup[2];
  911.     body_node = (Node) tup[3];
  912.     return_type = TYPE_OF(gen_name);
  913.  
  914.     /* Now match generic specification with instantiation.*/
  915.  
  916.     node_map = nodemap_new();   /* initialize */
  917.     tup = instantiate_generics(generics, instance_node);
  918.     instance_list = (Tuple) tup[1];
  919.     type_map= (Symbolmap) tup[2];
  920.     /*
  921.      * Use the instantiated generic types to obtain the actual signature and
  922.      * return type of the new procedure.
  923.      * Set default expression nodes temporarily to opt_node for the 
  924.      * call to chain_overloads (so that we avoid reprocessing them
  925.      * in process_formals). 
  926.      * Due to this kludge, we also test here (explicitly) that default 
  927.      * parameters are not specified for operator symbols.
  928.      * They are instantiated upon return from chain_overloads.
  929.      */
  930.     new_info = tup_new(tup_size(formals));
  931.     FORTUPI(f=(Symbol), formals, ii, ft1);
  932.         newtup = tup_new(4);
  933.         newtup[1] = (char *)ORIG_NAME(f);
  934.         newtup[2] = (char *)NATURE(f);
  935.         newtup[3] = (char *)replace(TYPE_OF(f), type_map);
  936.         newtup[4] = (char *)OPT_NODE;      /* temporarily */
  937.         new_info[ii] = (char *) newtup;
  938.         if ((Node)default_expr(f) != OPT_NODE)
  939.             has_default = TRUE;
  940.     ENDFORTUP(ft1);
  941.     new_return = replace(return_type, type_map);
  942.  
  943.     new_specs = tup_new(3);
  944.     new_specs[1] = (char *) kind;
  945.     new_specs[2] = (char *) new_return;
  946.     new_specs[3]= (char *) new_info;
  947.  
  948.     if (in_op_designators(new_id )) { /* check format, if operator spec */
  949.         check_new_op(id_node, new_info, new_return);
  950.         if (has_default)
  951.         errmsg("Initializations not allowed for operators", "6.7", instance_node);
  952.     }
  953.     /* Create new overloadable object with these specs.*/
  954.  
  955.     proc_name = chain_overloads(new_id, kind, new_return, new_info, (Symbol)0,
  956.       OPT_NODE);
  957.     /*
  958.      * in the body of the procedure, replace the generic name with the
  959.      * instantiated name. (it appears on the return statement, and of
  960.      * course in any recursive call).
  961.      * Also, map the names of the formals parameters into the names they
  962.      * have in the instantiated procedure (the actual formals ?)
  963.      * Instantiate default expressions for formals.
  964.      */
  965.     /* map the formals of the generic into the formals of the instantiation.*/
  966.  
  967.     new_formals = SIGNATURE(proc_name);
  968.     FORTUPI(new_f=(Symbol), new_formals, ii, ft1);
  969.         symbolmap_put(type_map, (Symbol) formals[ii], new_f);
  970.         default_expr(new_f) = (Tuple) instantiate_tree(
  971.           (Node) default_expr((Symbol)formals[ii]), type_map);
  972.     ENDFORTUP(ft1);
  973.     /* in the body of the subprogram, the generic name is replaced by the
  974.      * instantiated name. (it appears  on the  return  statement,  and of
  975.      * course in any recursive call). 
  976.      */
  977.     symbolmap_put(type_map, gen_name, proc_name);
  978.     N_UNQ(id_node) = proc_name;
  979.  
  980.     if (body_node == OPT_NODE) {
  981.         /* Attach type_map to node for subsequent instantiation (expander).
  982.          * For visibility purposes, only the formals of the subprogram are
  983.          * needed; the symbol table instantiation  will  also take place in
  984.          * the binder.
  985.          */
  986.         /* We must call instantiate_sybmtab here in order to have instantiated
  987.          * items placed in appropriate declared maps
  988.          */
  989.         newtup = instantiate_symbtab(gen_name, proc_name, type_map);
  990.         type_map = (Symbolmap) newtup[1];
  991.         newtup = tup_new(2);
  992.         newtup[1] = (char *) type_map;
  993.         newtup[2] = (char *) TRUE;
  994.         N_AST4(node) = new_instance_node(newtup);
  995.         /* original instance node not needed further */
  996.         if (instance_node != OPT_NODE)
  997.             N_KIND(N_AST3(node)) = as_list;
  998.         else N_AST3(node) = node_new(as_list);
  999.         /* to be included with decls in body */
  1000.         N_LIST(N_AST3(node)) = instance_list;
  1001.     }
  1002.     else {
  1003.         instantiate_subprog_tree(node, type_map);
  1004.         /*
  1005.           * Take the subprogram created by the instantiation and reformat
  1006.           * the subprogram node to be of a form as_subprogram_tr with the
  1007.           * specifcation part detached from the tree. Move up the id_node
  1008.           * (subprogram name) info to the subprogram node. The stmt_node 
  1009.           * needs to be moved to N_AST1 so that N_UNQ field can be used
  1010.           * to store unique name of subprogram.
  1011.           */
  1012.         spec_node = N_AST1(node);
  1013.         stmt_node = N_AST3(node);
  1014.         id_node = N_AST1(spec_node);
  1015.         N_KIND(node) = as_subprogram_tr;
  1016.         N_AST1(node) = stmt_node;
  1017.         N_UNQ(node) = N_UNQ(id_node);
  1018.         /* 
  1019.           * Emit the code that instantiates the generic parameters in front of  
  1020.           * the subprogram.
  1021.           */
  1022.         if (tup_size(instance_list) > 0)
  1023.             make_insert_node(node, instance_list, copy_node(node));
  1024.     }
  1025.  
  1026.     save_subprog_info(proc_name);
  1027. }
  1028.  
  1029. void package_instance(Node node)    /*;package_instance*/
  1030. {
  1031.     Node    id_node, gen_node, instance_node;
  1032.     Symbol    package, gen_name;
  1033.     Tuple    instance_list;
  1034.     Symbolmap    type_map;
  1035.     Node    package_node;
  1036.     Tuple    tup, gen_list;
  1037.     char     *body_name;
  1038.     int        is_comp, body_num, s;
  1039.     Set        body_precomp;
  1040.     Forset    fs1;
  1041.  
  1042.     if (cdebug2 > 3)
  1043.         TO_ERRFILE("AT PROC : package_instance");
  1044.     /*
  1045.      * Create  an  instantiation of a generic  package. The renaming and
  1046.      * instantiation of local objects is done as for subprograms.
  1047.      */
  1048.     is_comp = IS_COMP_UNIT;
  1049.     id_node = N_AST1(node);
  1050.     gen_node= N_AST2(node);
  1051.     instance_node = N_AST3(node);
  1052.     /* instantiate_generics adds to list - don't want to modify OPT_NODE */
  1053.     if (instance_node == OPT_NODE) {
  1054.         instance_node = node_new(as_list);
  1055.         N_LIST(instance_node) = tup_new(0);
  1056.         N_AST3(node) = instance_node;
  1057.     }
  1058.     new_package(id_node, na_package_spec);
  1059.     package = scope_name;
  1060.  
  1061.     find_old(gen_node);
  1062.     gen_name = N_UNQ(gen_node);
  1063.     if (gen_name == (Symbol)0) gen_name =  symbol_any_id;
  1064.     /* TBSL: the context of the generic needs to be transferred to the
  1065.      * instantiation in the case of a compilation unit. (see mod in
  1066.      * subprogram instance).
  1067.      */
  1068.     body_name = strjoin("bo", ORIG_NAME(gen_name));
  1069.     body_num = unitNumberFromLibUnit(body_name);
  1070.     if (is_comp) {
  1071.         if (body_num)
  1072.             all_vis = tup_with(all_vis, body_name);
  1073.     }
  1074.     if (body_num) {
  1075.         body_precomp = (Set) pUnits[body_num]->aisInfo.preComp;
  1076.         FORSET( s=(int), body_precomp, fs1 );
  1077.             all_vis = tup_with(all_vis,pUnits[s]->name);
  1078.         ENDFORSET(fs1);
  1079.     }
  1080.  
  1081.     /*
  1082.      * new_compunit will have already been called under the asssumption
  1083.      * that the current compilation unit is a non-generic package.    This
  1084.      * may be inefficient, but the second calls to new_compunit and
  1085.      * establish_context will act correctly.
  1086.      * Build temporary node "package_node" to call new_compunit.
  1087.      */
  1088.     package_node = node_new(as_simple_name);
  1089.     copy_span(id_node, package_node);
  1090.     N_VAL(package_node) = N_VAL(id_node);
  1091.     /* TBSL - SETL has 'spec instance' - I am doing as 'spec'  ds 30 jul */
  1092.     new_compunit("sp", package_node);
  1093.     if (
  1094.         /* !is_identifier(gen_name) ||  */
  1095.         /* is_identifier will always be true because was set above */
  1096.       (NATURE(gen_name) !=na_generic_package
  1097.       && NATURE(gen_name) !=na_generic_package_spec) ) {
  1098.         errmsg("not a generic package", "12.1", gen_node);
  1099.         popscope();
  1100.         return;
  1101.     }
  1102.     else if (in_open_scopes(gen_name)) {
  1103.         errmsg("Recursive instantiation not allowed", "12.3", gen_node);
  1104.         popscope();
  1105.         return;
  1106.     }
  1107. #ifdef XREF
  1108.     TO_XREF(gen_name);
  1109. #endif
  1110.     tup = SIGNATURE(gen_name);
  1111.     gen_list = (Tuple) tup[1];
  1112.     node_map = nodemap_new();   /* initialize */
  1113.     tup = instantiate_generics(gen_list, instance_node);
  1114.     instance_list = (Tuple) tup[1];
  1115.     type_map = (Symbolmap) tup[2];
  1116.     symbolmap_put(type_map, gen_name, package);
  1117.     instantiate_pack_tree(node, type_map, instance_list);
  1118.     end_specs(package);
  1119.     /*
  1120.      * The instantiated object is a package, although it appears syntact-
  1121.      * ically as a package spec. 
  1122.      */
  1123.     NATURE(package) = na_package;
  1124. }
  1125.